%%%-------------------------------------------------------------------
%%% File        : smtpdc.erl
%%% Author      : Fyodor Ustinov <ufm@ufm.su>
%%% Description : Part of SMTP Daemon
%%%               Communicate with client
%%%
%%% Created : 24 Aug 2009 by Fyodor Ustinov <ufm@ufm.su>
%%%-------------------------------------------------------------------
-module(smtpdc).

-behaviour(gen_server).

%% API
-export([start_link/1]).

%% gen_server callbacks
-export([init/1, handle_call/3, handle_cast/2, handle_info/2,
	 terminate/2, code_change/3]).

-include("mailer.hrl").

-define(config_get(S, X, Y), config:get(S#smtpdcs.subst, smtpd, X, Y)).
-define(subst(X, Y, Z), config:subst(smtpd, X, Y, Z)).

-record(smtpdcs, {id = "",                    % Message ID
		  subst = [],                 % Config substitution
		  csock,                      % Connected socket
		  myhostname="localhost",     % Hostname
		  from_ip={},                 % Sender address
		  from_name="",               % Sender name
		  tref=0,                     % Timer reference
		  timeout=0,                  % Current timeout
		  filter=0,                   % Filter function
		  maxtimeout=20,              % Max timeout between received lines
		  data = false,               % DATA state
		  header = false,             % Receive message header
		  maxbuffer = 20480000,       % Max Buffer size
		  mail = 0                    % Mail reference
		 }).


%%====================================================================
%% API
%%====================================================================
%%--------------------------------------------------------------------
%% Function: start_link() -> {ok,Pid} | ignore | {error,Error}
%% Description: Starts the server
%%--------------------------------------------------------------------
start_link(CSock) when is_port(CSock) ->
    gen_server:start_link(?MODULE, [CSock], []).

%%====================================================================
%% gen_server callbacks
%%====================================================================

%%--------------------------------------------------------------------
%% Function: init(Args) -> {ok, State} |
%%                         {ok, State, Timeout} |
%%                         ignore               |
%%                         {stop, Reason}
%% Description: Initiates the server
%%--------------------------------------------------------------------
init([CSock]) when is_port(CSock) ->
    S = #smtpdcs{csock = CSock},
    {Ra,Rb,Rc} = now(),
    random:seed(Ra,Rb,Rc),
    case inet:peername(S#smtpdcs.csock) of
	{ok,{Cip, _Cport}} ->
	    % -- S1 --
	    % accept connection by IP
	    S1 = S#smtpdcs{subst = ?subst(inet_parse:ntoa(Cip), ip_masks, [])},
	    case ?config_get(S1, accept_connection, true) of
		true ->
		    case ?config_get(S1, resolve_all_ip, true) of
			true ->
			    case inet:gethostbyaddr(Cip) of
				{ok, H} ->
				    Cname = H#hostent.h_name;
				_ ->
				    Cname = "unknown"
			    end;
			false ->
			    Cname = "unknown"
		    end,
		    % -- S2 --
		    % accept connection by name
		    S2 =  S1#smtpdcs{subst = ?subst(Cname, host_masks, S1#smtpdcs.subst)},
io:format("S2#smtpdcs.subst == '~p'~n",[S2#smtpdcs.subst]),
		    case ?config_get(S2, accept_connection, true) of
			true ->
			    Id = mlib:genID(),
			    {ok, Filter} = gen_server:call(filter,{smtpd, get_filter}),
			    {ok, Mail} = gen_server:call(storage, {create_msg, Id, ?INBOUND}),
			    {ok, Tref} = timer:send_interval(1000, self(), tick),
			    Mail(set_fromip, Cip),
			    Mail(set_fromname, Cname),
			    Mail(set_time, now()),
			    Mail(set_myhostname, ?config_get(S2, myhostname, "localhost")),
			    S3 = S2#smtpdcs{id = Id, 
					    tref = Tref, 
					    filter = Filter, 
					    mail = Mail, 
					    from_ip = Cip, 
					    from_name = Cname,
					    myhostname = ?config_get(S2, myhostname, "localhost"),
					    maxtimeout = ?config_get(S2, receive_timeout, 20),
					    maxbuffer  = ?config_get(S2, max_msg_size, 0)
					   },
			    case Filter(start_session, Mail) of
				ok ->
				    send(S3, "220 ~s MailEr SMTP server ready.", [S3#smtpdcs.myhostname]),
				    inet:setopts(S#smtpdcs.csock,[{active,once}]),
				    {ok, S3};

				{error, Reason} ->
				    send(S3, Reason),
				    inet:setopts(S#smtpdcs.csock,[{active,once}]),
				    {ok, S3};

				{stop, Reason} ->
				    send(S3, Reason),
				    gen_tcp:close(S3#smtpdcs.csock),
				    {stop, normal}
			    end;

			{false, Reason} -> % No accept by name
			    send(S2, Reason),
			    gen_tcp:close(S2#smtpdcs.csock),
			    {stop, normal}
		    end;

		{false, Reason} -> % No accept by IP
		    send(S1, Reason),
		    gen_tcp:close(S1#smtpdcs.csock),
		    {stop, normal}
	    end;

	Error -> 
	    send_error(S),
	    gen_tcp:close(S#smtpdcs.csock),
	    {stop, Error}
    end
.

%%--------------------------------------------------------------------
%% Function: %% handle_call(Request, From, State) -> {reply, Reply, State} |
%%                                      {reply, Reply, State, Timeout} |
%%                                      {noreply, State} |
%%                                      {noreply, State, Timeout} |
%%                                      {stop, Reason, Reply, State} |
%%                                      {stop, Reason, State}
%% Description: Handling call messages
%%--------------------------------------------------------------------

handle_call(enable_flow, _From, S) ->
    Rc = inet:setopts(S#smtpdcs.csock, [{active, once}]),
    {reply, Rc, S};

handle_call(_Request, _From, State) ->
    Reply = error,
    {reply, Reply, State}
.

%%--------------------------------------------------------------------
%% Function: handle_cast(Msg, State) -> {noreply, State} |
%%                                      {noreply, State, Timeout} |
%%                                      {stop, Reason, State}
%% Description: Handling cast messages
%%--------------------------------------------------------------------
handle_cast(_Msg, State) ->
    {noreply, State}.

%%--------------------------------------------------------------------
%% Function: handle_info(Info, State) -> {noreply, State} |
%%                                       {noreply, State, Timeout} |
%%                                       {stop, Reason, State}
%% Description: Handling all non call/cast messages
%%--------------------------------------------------------------------

handle_info({tcp, Sock, Data}, #smtpdcs{csock=Sock, data=DataMode} = S) 
  when DataMode =:= true ->
    Rc = case Data of
	     <<$.,$\r,$\n>> ->
		 F = S#smtpdcs.filter,
		 ok = normalise_kludges(S),
		 case F(stop_data, S#smtpdcs.mail) of
		     ok ->
			 try
			     ok = store_mail(S),
			     Sn = S#smtpdcs{mail = 0},
			     send(Sn,"250 2.1.0 Message queued with ID: " ++ Sn#smtpdcs.id),
			     {noreply, clean_status(S)}
			 catch
			     _A:_B ->
				 io:format("Catch for store_mail: '~p', '~p'~n",[_A,_B]),
				 send_error(S),
				 {stop, normal, S}
			 end;
		     {error, Reason} ->
			 send(S,Reason),
			 {noreply, clean_status(S)};
		     {stop, Reason} ->
			 send(S,Reason),
			 {stop, normal, S}
		 end;
	     
	     <<$.,$.,Rest/binary>> ->
		 Tmt = list_to_binary([[$.],Rest]),
		 ok = (S#smtpdcs.mail)(add_line, Tmt),
		 {noreply, S#smtpdcs{header = false, timeout = 0}};

	     <<Any/binary>> ->
		 try
		     true = S#smtpdcs.header,
		     ok = (S#smtpdcs.mail)(add_kludge, Any),
		     {ok, BSize} = (S#smtpdcs.mail)(get_size,[]),
		     case BSize > S#smtpdcs.maxbuffer of
			 true -> 
			     send(S,"552 5.2.3 Message too long."),
			     {noreply,clean_status(S)};
			 _ ->
			     {noreply, S#smtpdcs{timeout = 0}}
		     end
		 catch
		     _:_ ->
			 ok = (S#smtpdcs.mail)(add_line, Any),
			 {ok, BBSize} = (S#smtpdcs.mail)(get_size,[]),
			 case BBSize > S#smtpdcs.maxbuffer of
			     true -> 
				 send(S,"552 5.2.3 Message too long."),
				 {noreply,clean_status(S)};
			     _ ->
				 {noreply, S#smtpdcs{header = false, timeout = 0}}
			 end
		 end
	 end,
    inet:setopts(S#smtpdcs.csock,[{active, once}]),
    Rc
;

handle_info({tcp, Sock, Data}, #smtpdcs{csock = Sock} = S) ->
    {Cmd,Param} = parse(Data),
    case command(S, Cmd, Param) of
	{ok, Sn} ->
%%%%	    io:format("'~p', '~p' [~p]~n",[Cmd, Param,Sn]),
	    inet:setopts(Sn#smtpdcs.csock,[{active, once}]),
	    {noreply,Sn#smtpdcs{timeout = 0}};
	{quit, Sn} ->
	    {stop, normal, Sn}
    end;

%%
%% -- Handle close socket --
%%
handle_info({tcp_closed, CSock}, #smtpdcs{csock = CSock} = S) ->
    Sn = S#smtpdcs{csock = 0},
    {stop, normal, Sn};


%%
%% -- Handle timeout --
%%
handle_info(tick, #smtpdcs{timeout = Timeout, maxtimeout = Maxtimeout} = S) ->
    if
	Timeout > Maxtimeout ->
	    send(S, "421 4.4.2 <~s> timeout", [S#smtpdcs.myhostname]),
	    {stop, normal, S};
	true ->
	    {noreply, S#smtpdcs{timeout = Timeout + 1}}
    end;

%%
%% -- Unknown event --
%%
handle_info(Info,State) ->
    io:format("smtpdc info:~p, ~p~n", [Info, State]),
    {noreply, State}
.

%%--------------------------------------------------------------------
%% Function: terminate(Reason, State) -> void()
%% Description: This function is called by a gen_server when it is about to
%% terminate. It should be the opposite of Module:init/1 and do any necessary
%% cleaning up. When it returns, the gen_server terminates with Reason.
%% The return value is ignored.
%%--------------------------------------------------------------------
terminate(Reason, S) ->
    timer:cancel(S#smtpdcs.tref),
    stop_filter(S),
    {ok, Pid} = (S#smtpdcs.mail)(get_pid,[]),
    erlang:is_process_alive(Pid) andalso gen_server:call(storage, {destroy_msg, S#smtpdcs.id}),
    if
	Reason =:= shutdown orelse Reason =:= timeout ->
	    io:format("SMTPDC: shutdown~n~p~n",[Reason]),
	    case erlang:port_info(S#smtpdcs.csock) of
		[_|_] ->
		    send_error(S),
		    gen_tcp:close(S#smtpdcs.csock);
		undefined -> 
		    ok
	    end;
	Reason =:= normal -> 
	    gen_tcp:close(S#smtpdcs.csock),
	    ok,
	    io:format("Normal shutdown~n");

	true -> 
	    io:format("Ooops, [~p]~n",[Reason]),
	    case erlang:port_info(S#smtpdcs.csock) of
		[_|_] ->
		    send_error(S),
		    gen_tcp:close(S#smtpdcs.csock);
		undefined -> 
		    ok
	    end
    end,
    ok.

%%--------------------------------------------------------------------
%% Func: code_change(OldVsn, State, Extra) -> {ok, NewState}
%% Description: Convert process state when code is changed
%%--------------------------------------------------------------------
code_change(_OldVsn, State, _Extra) ->
    {ok, State}.

%%--------------------------------------------------------------------
%%% Internal functions
%%--------------------------------------------------------------------

clean_status(S) ->
    {ok, Pid} = (S#smtpdcs.mail)(get_pid,[]),
    erlang:is_process_alive(Pid) andalso gen_server:call(storage, {destroy_msg, S#smtpdcs.id}),
    Id = mlib:genID(),
    {ok, Mail} = gen_server:call(storage, {create_msg, Id, ?INBOUND}),
    Mail(set_fromip, S#smtpdcs.from_ip),
    Mail(set_fromname, S#smtpdcs.from_name),
    Mail(set_time, now()),
    Mail(set_myhostname, S#smtpdcs.myhostname),
    S#smtpdcs{id = Id, subst = [], timeout=0, data = false, header = false, mail = Mail}
.

send_error(S) ->
    send(S,"421 4.3.0 <" ++ S#smtpdcs.myhostname ++ "> Internal error. Sorry.").

send_ok(S) ->
    send(S,"250 2.1.0 Ok.").

send_notimplemented(S) ->
    send(S,"502 5.5.5 Command not implemented.").

send_unrecognized(S) ->
    send(S,"500 5.5.2 Command unrecognized or syntax error.").

send_badsequence(S) ->
    send(S,"503 5.5.1 Bad sequence of commands.").
    

send(S, Format) ->
    send(S, Format, []).

send(S,Format,Args) ->
    prim_inet:send(S#smtpdcs.csock,io_lib_format:fwrite(Format ++ "\r\n",Args)).


%%

parse(Bin) when is_binary(Bin) ->
    parse(binary_to_list(Bin));

parse(L) when is_list(L) ->
    case string:tokens(L," \r\n\0") of
	[] -> {noop,[]};
	[Command|Param] -> {list_to_atom(string:to_lower(Command)),string:join(Param," ")}
    end
.

%% -- Commands --

dual_command(Cmd,Part) ->
    case string:tokens(Cmd,":") of
	[] ->
	    {error,Cmd};
	[_C|[]] ->
	    {error,Cmd};
	[C|P] ->
	    if
		length(P) > 1 ->
		    {error, P};
		true ->
		    Cc = string:to_lower(C),
		    if 
			Cc =:= Part ->
			    {ok,string:strip(lists:nth(1,P),left)};
			true -> 
			    {error,C}
		    end
	    end
    end.

%% -- QUIT --

command(S, quit, Param) 
  when Param =:= [] ->
    send(S, "221 <" ++ S#smtpdcs.myhostname ++ "> bye."),
    {quit, S};

%% -- NOOP --

command(S, noop, Param) 
  when Param =:= [] ->
    filter(noop, S, "2.0.0 Ok.");

%% -- HELP --

command(S, help, Param) 
  when Param =:= [] ->
    send(S, "214 2.0.0 Only God will help you."),
    {ok, S};

%% -- RSET --

command(S, rset, Param)
  when Param =:= [] ->
    Sn = clean_status(S),
    send_ok(Sn),
    {ok, Sn};

%% -- HELO --

command(S, helo, Param)
  when Param =/= [] ->
%%---- not for helo???
    Sn = clean_status(S),
%%----
    ok = (Sn#smtpdcs.mail)(change_sanity, 1),
    Dm = lists:nth(1,string:tokens(Param,"[]")),
    length(Dm) < 4 andalso (S#smtpdcs.mail)(change_sanity, -1),
    FromIP = (Sn#smtpdcs.mail)(get_fromip, []),
    case inet_parse:domain(Dm) of
	true ->
	    FromIP =:= inet:getaddr(Dm, inet) andalso (Sn#smtpdcs.mail)(change_sanity, 2);
	false ->
	    FromIP =:= inet_parse:address(Dm) andalso (Sn#smtpdcs.mail)(change_sanity, 1)
    end,
    ok = (Sn#smtpdcs.mail)(set_hello, Param),
    filter(hello, Sn, Sn#smtpdcs.myhostname);

%% -- MAIL FROM: --

command(S, mail, Param)
  when Param =/= [] ->
    {ok, RcptTo} = (S#smtpdcs.mail)(get_rcptto,[]),
    if 
	RcptTo =:= [] ->
	    case dual_command(Param, "from") of
		{ok, P} ->
		    Addr = string:tokens(P,"@<>"),
		    case length(Addr) =:= 2 andalso inet_parse:domain(lists:nth(2,Addr))=:= true of
			true ->
			    ok = (S#smtpdcs.mail)(set_mailfrom, list_to_tuple(Addr)),
			    filter(mail_from, S, "2.1.0 Ok.");

			false ->
			    if 
				P =:= "<>" ->
				    ok = (S#smtpdcs.mail)(set_mailfrom, {"<>",""}),
				    filter(mail_from, S, "2.1.0 Ok.");
				
				true ->
				    send(S, "553 5.1.7 Wrong source adress."),
				    {ok, S}
			    end
		    end;

		{error, _} ->
		    send_unrecognized(S),
		    {ok, S}
	    end;
	true ->
	    send_badsequence(S),
	    {ok, S}
    end
;

%% - RCPT TO: --

command(S, rcpt, Param)
  when Param =/= [] ->
    {ok, RcptTo} = (S#smtpdcs.mail)(get_rcptto,[]),
    if
	length(RcptTo) >= 100 ->
	    send(S, "452 5.5.3 Too many recipients"),
	    {ok, S};
	true ->
	    {ok, MailFrom} = (S#smtpdcs.mail)(get_mailfrom,[]),
	    if 
		MailFrom =/= "" ->
		    case dual_command(Param,"to") of
			{ok, P} ->
			    Addr = string:tokens(P,"@<>"),
			    case length(Addr) =:= 2 andalso inet_parse:domain(lists:nth(2,Addr))=:= true of
				true ->
				    ok = (S#smtpdcs.mail)(add_rcptto, list_to_tuple(Addr)),
				    filter(rcpt_to, S, "2.1.5 Ok.");

				false ->
				    send(S, "553 5.1.3 Wrong destination adress."),
				    {ok, S}
			    end;

			{error, _} ->
			    send_unrecognized(S),
			    {ok, S}
		    end;
		true ->
		    send_badsequence(S),
		    {ok, S}
	    end
    end
;

%%
%% -- DATA --
%%

command(S, data, Param) 
  when Param =:= [] ->
    {ok, RcptTo} = (S#smtpdcs.mail)(get_rcptto,[]),
    {ok, MailFrom} = (S#smtpdcs.mail)(get_mailfrom,[]),
    if
	RcptTo =:= [] orelse MailFrom =:= "" ->
	    send_badsequence(S),
	    {ok, S};
	true ->
	    case (S#smtpdcs.filter)(start_data,S#smtpdcs.mail) of
		ok ->
		    send(S,"354 End data with <CR><LF>.<CR><LF>"),
		    {ok, S#smtpdcs{data = true, header = true}};
		{error, Reason} ->
		    send(S, Reason),
		    {ok, S};
		{stop, Reason} ->
		    send(S, Reason),
		    {quit, S}
	    end
    end
;


%%
%% -- Not implemented commands --
%%

command(S,expn,_) ->
    send_notimplemented(S),
    {ok, S};

command(S,vrfy,_) ->
    send_notimplemented(S),
    {ok, S};

%% -- deprecated --

command(S,turn,_) ->
    send_notimplemented(S),
    {ok, S};

command(S,soml,_) ->
    send_notimplemented(S),
    {ok, S};

command(S,saml,_) ->
    send_notimplemented(S),
    {ok, S};

command(S,send,_) ->
    send_notimplemented(S),
    {ok, S};

%% -- unknown --

command(S,_,_) ->
    send_unrecognized(S),
    {ok, S}
.

%% ----------------------------------------

store_mail(S)
  when is_record(S, smtpdcs) ->
    {ok, RcptTo} = (S#smtpdcs.mail)(get_rcptto,[]),
    MRcptTo = lists:last(RcptTo),
    ok = (S#smtpdcs.mail)(set_rcptto, MRcptTo),
    ok = (S#smtpdcs.mail)(store,[]),
    ok = store_mail(S#smtpdcs.mail, RcptTo),
    ok = gen_server:call(storage, {close_msg, S#smtpdcs.id}),
    ok
.

store_mail(_F, []) ->
    ok
;

store_mail(F,[H|[]])
  when is_function(F, 2), is_tuple(H) ->
    ok
;

store_mail(F,[H|T])
  when is_function(F, 2), is_tuple(H) ->
    Id = mlib:genID(),
    {ok, Mail} = gen_server:call(storage, {create_msg, Id, ?INBOUND}),
    ok = Mail(duplicate, F),
    ok = Mail(set_rcptto, H),
    ok = Mail(store,[]),
    ok = gen_server:call(storage, {close_msg, Id}),
    store_mail(F,T)
.
    
    

%% filter(Cmd, S)
%%   when is_atom(Cmd), is_record(S, smtpdcs) ->
%%     filter(Cmd, S, "Ok.")
%% .

filter(Cmd, S, OkString)
  when is_atom(Cmd), is_record(S, smtpdcs) ->
    case (S#smtpdcs.filter)(Cmd, S#smtpdcs.mail) of
	ok->
	    send(S, "250 " ++ OkString),
	    {ok, S};
	{error, Reason} ->
	    send(S, Reason),
	    {ok, S};
	{stop, Reason} ->
	    send(S, Reason),
	    {quit, S}
    end
.

stop_filter(S)
  when is_record(S,smtpdcs) ->
    (S#smtpdcs.filter)(stop,[]),
    ok
.
    

normalise_kludges(S)
  when is_record(S, smtpdcs) ->
    ok = (S#smtpdcs.mail)(add_newkludge,{"Message-ID","<" ++ S#smtpdcs.id ++ "@" ++ S#smtpdcs.myhostname ++ ">"}),
    ok = (S#smtpdcs.mail)(add_newkludge,{"Date",httpd_util:rfc1123_date()}),
    {ok, {Fname, Fdomain}} = (S#smtpdcs.mail)(get_mailfrom,[]),
    FrAdr = if 
	length(Fdomain) =:= 0 ->
	    "<>";
	true ->
	   Fname ++ "@" ++ Fdomain
    end,
    ok = (S#smtpdcs.mail)(add_newkludge,{"From",FrAdr}),
    ok = (S#smtpdcs.mail)(add_newkludge,{"To","undisclosed-recipients:;"}),
    ok = (S#smtpdcs.mail)(add_newkludge,{"Return-Path",FrAdr}),
    ok
.
